home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 8: LINUX Games / Linux Cubed Series 8 - LINUX Games.iso / games / x11 / rpg / crossfir.92 / crossfir / crossfire-0.92.5 / utils / tcpsockets.pl < prev   
Perl Script  |  1996-07-24  |  2KB  |  103 lines
  1. #$Id: tcpsockets.pl,v 1.1.1.1 1993/03/07 08:30:51 frankj Exp $
  2. package main;
  3. require 'sys/socket.ph';
  4. package tcpsockets;
  5.  
  6. require 'gensym.pl';
  7.  
  8. # Config Stuff
  9. $listenqueue = 5;
  10. # End of Config Stuff
  11.  
  12. $sockaddr = 'S n a4 x8';
  13.  
  14. $localhostname = `/bin/hostname`;
  15.  
  16. chop($localhostname);
  17.  
  18. ($name,$aliases,$type,$len,$thisaddr) = gethostbyname($localhostname);
  19.  
  20. die("Couldn't get address of $localhostname\n") if ! defined $thisaddr;
  21.  
  22. ($name, $aliases, $proto) = getprotobyname('tcp');
  23.  
  24. sub getsocket {
  25.     local($port) = @_;
  26.     $port = $port || 0;
  27.     $socket = &gensym'get;
  28.  
  29.     socket($socket, &main'PF_INET, &main'SOCK_STREAM, $proto) 
  30.     || die "$0 - socket: $!";
  31.     $this = pack($sockaddr, &main'AF_INET, $port, $thisaddr);
  32.     $foo = setsockopt($socket,&main'SOL_SOCKET,&main'SO_REUSEADDR,1);
  33.     die("Unable to setsockopt;$!\n") unless defined $foo;
  34.     $foo = setsockopt($socket,&main'SOL_SOCKET,&main'SO_DONTLINGER,1);
  35.     die("Unable to setsockopt;$!\n") unless defined $foo;
  36.     bind($socket, $this) || die "$0 - bind: $!";
  37.     return $socket;
  38. }
  39.  
  40. sub getport {
  41.     die ("Internal Error:getport called wrong\n") if $#_ !=0;
  42.     ($name,$aliases,$port) = getservbyname($_[0],'tcp')
  43.     unless $port =~ /^\d+$/o;
  44.     return $port;
  45. }
  46.  
  47. sub getconnection {
  48.     local($them,$port) = @_;
  49.     
  50.     if ($them =~ /^\d+\.\d+\.\d+\.\d+$/o) {
  51.     ($one,$two,$three,$four) = split(/\./o,$them);
  52.     $thataddr = pack('C4',$one,$two,$three,$four);
  53.     } else {
  54.     ($name,$aliases,$type,$len,$thataddr) = gethostbyname($them);
  55.     }
  56.  
  57.     $port = &getport($port);
  58.  
  59.     warn("Thataddr undefined -- $them\n") if ! defined $thataddr;
  60.  
  61.     $that = pack($sockaddr, &main'AF_INET, $port, $thataddr);
  62.  
  63.     $socket = &getsocket(0);
  64.  
  65.     connect($socket, $that) || die "$0: connection refused by $them:$!";
  66.  
  67.     $old = select($socket); $|=1;select($old);
  68.  
  69.     return $socket;
  70. }
  71.  
  72. sub getacceptor {
  73.     local($port) = @_;
  74.  
  75.     $port = &getport($port);
  76.  
  77.     $socket = &getsocket($port);
  78.     listen($socket,$listenqueue);
  79.  
  80.     $old = select($socket); $|=1;select($old);
  81.  
  82.     return $socket;
  83. }
  84.  
  85. sub getportnumber {
  86.     $mysockaddr = getsockname($_[0]);
  87.     ($family , $port, $myaddr) = unpack($sockaddr,$mysockaddr);
  88.     return $port;
  89. }
  90.  
  91. sub getinetaddr {
  92.     ($af,$port,$inetaddr) = unpack($sockaddr,$_[0]);
  93.     return unpack('C4',$inetaddr);
  94. }
  95.  
  96. sub getlocaladdress {
  97.     return unpack ('C4',$thisaddr);
  98. }
  99.  
  100.     
  101. #Revision 1.1  1992/06/08  17:02:15  eanders
  102. #Initial revision
  103.